home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 2 / Amiga Tools 2.iso / tools / mg / rexx / testrexxregion.mg < prev    next >
Text File  |  1995-03-09  |  3KB  |  114 lines
  1. /*
  2.  * Run the tests in the introductory comments to a region.
  3.  *
  4.  * The region marked at the time of invocation will be tested. It should
  5.  * be suitable for calling as a rexx function, and return a string value.
  6.  * It must start with a comment that contains lines describing the tests
  7.  * to be run, the comment ending with a single line having a comment end
  8.  * string on it (with optional whitespace).
  9.  *
  10.  * The format for a test line is:
  11.  * <whatever> test: <expected result> (<argument strings>) <actual result>
  12.  *
  13.  * <whatever> will be ignored.
  14.  *
  15.  * <argument strings> are the arguments to be passed to the region, formatted
  16.  * for use by rexx-do-region. Note that if there are no arguments, then
  17.  * the argument list should be ( 0 ). If there are arguments, then the
  18.  * first thing in the argument list should be the negative of the number of
  19.  * arguments, i.e.: ( -3 "This is" a "\^c" ).
  20.  *
  21.  * <expected results> is the value that it is expected that the function will
  22.  * return when the marked region is started via
  23.  * 'rexx-do-region' argument strings
  24.  *
  25.  * <actual results> are placed by this code. If they match the expected
  26.  * results, they are left blank. Otherwise, it is changed to the actual
  27.  * result. If there was some problem with the result (for example, it
  28.  * occupied more than one line), then the results will be assumed to have
  29.  * been "****".
  30.  */
  31.  
  32. /* Canonical mg prefix. */
  33. options results
  34. options failat 2
  35. signal on failure
  36.  
  37. /* Constants for this invocation */
  38. bufname = "*Rexx-Test*"
  39. flag =  "****"
  40.  
  41. /* Clean out the test buffer, and copy the region to it */
  42. 'switch-to-buffer "'bufname'"'
  43. 'beginning-of-buffer'
  44. 'end-of-buffer'
  45. 'kill-region'
  46. 'switch-to-buffer ""'    /* Null string -> goes to previous buffer */
  47. 'copy-region-as-kill'
  48. 'switch-to-buffer ""'
  49. 'yank'
  50.  
  51. /* Find and store all the tests, including the line number the test is on */
  52. i = 1
  53. 'beginning-of-buffer'
  54.  
  55. do until rc ~= 0
  56.     'rexx-point pnt'
  57.     if pnt.3 = '*/' then break
  58.     parse value pnt.3 with 'test:' exp '(' args ')'
  59.     if exp ~= "" then do
  60.         test.i.argstring = args
  61.         test.i.expected = exp
  62.         test.i.line = pnt.1
  63.         i = i + 1
  64.         end
  65.     'next-line'
  66.     end
  67. numtests = i - 1
  68.  
  69. /* If there aren't any tests, we can stop here */
  70. if numtests < 1 then do
  71.     'rexx-display "No tests to run."'
  72.     exit 0
  73.     end
  74.  
  75. /* Now run each test, and stash the result */
  76. do i = 1 to numtests
  77.     'end-of-buffer'
  78.     'beginning-of-buffer'
  79.     signal off failure
  80.     'rexx-do-region' test.i.argstring
  81.     signal on failure
  82.     'beginning-of-buffer'
  83.     'rexx-region region'
  84.     if region.0 = 1 then test.i.value = region.1
  85.     else do
  86.         test.i.value = flag
  87.         iterate
  88.         end
  89.     'kill-region'
  90.     end
  91.  
  92. /*
  93.  * Finally, go check each test against the expected result, and insert the
  94.  * appropriate thing in the buffer.
  95.  */
  96. 'switch-to-buffer ""'
  97. do i = 1 to numtests
  98.     'goto-line' test.i.line
  99.     'search-forward )'
  100.     'rexx-insert "\tx"'
  101.     'backward-char'
  102.     'kill-line'
  103.     if test.i.value ~= test.i.expected then
  104.         'rexx-insert 'slashquote(test.i.value, '\')
  105.     end
  106.  
  107. /* And, since all's well that ends well, exit */
  108. exit 0
  109.  
  110. /* Come here if some command has serious problems */
  111. failure:
  112.     'rexx-display "something died!"'
  113.     exit 1
  114.